\ floodfill 05.3.13 NAB
\ A non-recursive flood fill algorithm.
\ Fills any bounded area with the
\ current drawing color.
\ Do not fill any unbounded area,
\ or area right on the edge of the
\ screen.
\ OS3.5 (or up) required.

needs graphics
needs core-ext
needs color

module floodfill

private:

variable fill-color
variable points

: current-color ( -- color )
  get-colors 2drop sp@
  WinRGBToIndex 2swap 2drop ;

: get-pixel ( y x -- color )
  WinGetPixel ; inline

: clear? ( y x -- flag )
  get-pixel  fill-color @  = ; inline

: border? ( y x -- flag )
  clear? invert ; inline

: fill-line ( y x -- left right )
  2dup  ( y x y x)
  begin  1+  2dup border? until
  ( y x y end)
  1- >r drop  1+  ( y x-1 )
  begin  1-  2dup border? until
  1+  ( y begin)
  over  r>  ( y begin y end )
  2over 2over line
  nip rot drop ;

: testpair ( y x -- flag )
  2dup clear? >r  1+ border?  r> and ;

: add-point ( -- )  1 points +! ; inline

: scanline
( y left right -- y | y x1 [... y xn] y )
  1+ swap ( right+1 left ) ?do
    i 2dup testpair if
      add-point  over
    else  drop  then
  loop ;

: scanlast ( y y right -- y | y right y )
  2dup clear? if  add-point  rot
  else  2drop  then ;

: pour ( y x -- )
  1 points !
  begin
    2dup clear? if
      over swap ( y  y x ) fill-line  2>r
      1- 2r@ scanline  dup r@ scanlast
      2 +  2r@ scanline  dup r> scanlast
      r>  2drop
    else  2drop 
    then ( )
  -1 points +!  points @ 0= until ;

public:

: floodfill ( y x -- ) 
  2dup get-pixel  dup fill-color !
  current-color <> if  pour
  else  2drop  then ;

end-module